home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / Sort.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1994-07-11  |  10.9 KB  |  308 lines  |  [.Ob./.Ob4]
  1. Syntax10.Scn.Fnt
  2. FoldElems
  3. Syntax10.Scn.Fnt
  4. Syntax10i.Scn.Fnt
  5. FoldElems
  6. Syntax10.Scn.Fnt
  7.     BEGIN IF ~cond THEN HALT(100) END
  8.     END ASSERT;
  9. Syntax10.Scn.Fnt
  10.     BEGIN
  11.         DEC(n);
  12.         WHILE n > 0 DO
  13.             IF array[n] < array[n-1] THEN RETURN FALSE END;
  14.             DEC(n)
  15.         END;
  16.         RETURN TRUE
  17.     END Sorted;
  18. Syntax10.Scn.Fnt
  19.         VAR
  20.             i, j: INTEGER;
  21.             a: String;
  22.     BEGIN
  23.         Out.Str("Bubble sort: "); Out.Int(n, 0); Out.Ln;
  24.         Time.Start;
  25.         FOR i := n-1 TO 1 BY -1 DO
  26.             FOR j := 1 TO i DO
  27.                 IF array[j-1] > array[j] THEN a := array[j]; array[j] := array[j-1]; array[j-1] := a END;
  28.             END
  29.         END
  30.         ;Time.Stop
  31.         ;ASSERT(Sorted(n))
  32.     END BSortArray;
  33.         sorter: PROCEDURE (array: Array; n: INTEGER);
  34.     PROCEDURE ASSERT(cond: BOOLEAN);    (*Ensure that cond is true*)
  35.     PROCEDURE Sorted(n: INTEGER): BOOLEAN;    (*Is array sorted?*)
  36.     PROCEDURE BSortArray(n: INTEGER);    (*Sort n elements of array in ascending order, BubbleSort*)
  37. Syntax10i.Scn.Fnt
  38. Syntax10.Scn.Fnt
  39.     BEGIN
  40.         Texts.WriteInt(W, n, 0);
  41.         IF n = 1 THEN Texts.WriteString(W, " line ")
  42.         ELSE Texts.WriteString(W, " lines ")
  43.         END;
  44.         Texts.WriteString(W, str); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
  45.     END WriteMsg;
  46. Syntax10.Scn.Fnt
  47. Syntax10i.Scn.Fnt
  48. FoldElems
  49. Syntax10.Scn.Fnt
  50. FoldElems
  51. Syntax10.Scn.Fnt
  52. Out.Str("Comb sort: "); Out.Int(n, 0); Out.Ln;
  53.         Time.Start;
  54. Syntax10.Scn.Fnt
  55. ;Time.Stop
  56.         ;ASSERT(Sorted(n))
  57.         VAR
  58.             gap, j: INTEGER;
  59.             a: String;
  60.             swap: BOOLEAN;
  61.     BEGIN
  62.         gap := n;
  63.         REPEAT
  64.             gap := gap*10 DIV 13; IF gap = 0 THEN gap := 1 END;
  65.             REPEAT
  66.                 j := gap; swap := FALSE;
  67.                 WHILE j < n DO
  68.                     IF array[j-gap] > array[j] THEN
  69.                         a := array[j]; array[j] := array[j-gap]; array[j-gap] := a;
  70.                         swap := TRUE
  71.                     END;
  72.                     INC(j)
  73.                 END
  74.             UNTIL ~swap
  75.         UNTIL (gap = 1) & ~swap
  76.     END CSortArray;
  77. PROCEDURE CSortArray(array: Array; n: INTEGER);    (*Sort n elements of array in ascending order, CombSort*)
  78. Syntax10.Scn.Fnt
  79. FoldElems
  80. Syntax10.Scn.Fnt
  81.             VAR i, j: INTEGER; a: String;
  82.         BEGIN
  83.             i := left; j := 2*left; a := array[left];
  84.             IF (j < right) & (array[j] < array[j+1]) THEN INC(j) END;
  85.             WHILE (j <= right) & (a < array[j]) DO
  86.                 array[i] := array[j]; i := j; j := 2*j;
  87.                 IF (j < right) & (array[j] < array[j+1]) THEN INC(j) END
  88.             END;
  89.             array[i] := a
  90.         END Sift;
  91. Syntax10.Scn.Fnt
  92. Out.Str("Heap sort: "); Out.Int(n, 0); Out.Ln;
  93.         Time.Start;
  94. Syntax10.Scn.Fnt
  95. ;Time.Stop
  96.         ;ASSERT(Sorted(n))
  97.         VAR
  98.             left, right: INTEGER;
  99.             a: String;
  100.         PROCEDURE Sift(left, right: INTEGER);
  101.     BEGIN
  102.         left := n DIV 2; right := n-1;
  103.         WHILE left > 0 DO DEC(left); Sift(left, right) END;
  104.         WHILE right > 0 DO
  105.             a := array[0]; array[0] := array[right]; array[right] := a;
  106.             DEC(right); Sift(left, right)
  107.         END
  108.     END HSortArray;
  109. Syntax10.Scn.Fnt
  110. Syntax10i.Scn.Fnt
  111. FoldElems
  112. Syntax10.Scn.Fnt
  113. Syntax10i.Scn.Fnt
  114.         VAR
  115.             pos: LONGINT;
  116.             R: Texts.Reader;
  117.             ch: CHAR;
  118.     BEGIN
  119.         n := 0;
  120.         IF text.len = 0 THEN RETURN END;
  121.         Texts.OpenReader(R, text, text.len-1); Texts.Read(R, ch);
  122.         IF ch # 0DX THEN Texts.Write(W, 0DX); Texts.Append(text, W.buf) END;    (*terminate text with a CR*)
  123.         Texts.OpenReader(R, text, 0);
  124.         FOR pos := 0 TO text.len-1 DO
  125.             Texts.Read(R, ch);
  126.             IF ch = 0DX THEN INC(n) END
  127.         END
  128.     END GetNofLines;
  129.     PROCEDURE UseBubble*;    BEGIN sorter := BSortArray END UseBubble;
  130.     PROCEDURE UseComb*;    BEGIN sorter := CSortArray END UseComb;
  131.     PROCEDURE UseHeap*;    BEGIN sorter := HSortArray END UseHeap;
  132.     PROCEDURE GetNofLines(text: Texts.Text; VAR n: INTEGER);
  133.     (*Count number of lines in text; terminate text with a CR if necessary*)
  134. Syntax10.Scn.Fnt
  135. Syntax10i.Scn.Fnt
  136. FoldElems
  137. Syntax10.Scn.Fnt
  138.                 ; IF n = NofLines THEN WriteMsg(NofLines, "exceeded!"); n := 0; RETURN END
  139. Syntax10.Scn.Fnt
  140. ;FOR i := 0 TO n-1 DO
  141.             j := 0; REPEAT Out.Int(ORD(array[i, j]), 4); INC(j) UNTIL array[i, j] = 0X
  142.         END; Out.Ln
  143.         VAR
  144.             i, j: INTEGER;
  145.             len, pos: LONGINT;
  146.             R: Texts.Reader;
  147.             ch: CHAR;
  148.             white: BOOLEAN;
  149.     BEGIN
  150.         len := text.len; IF len = 0 THEN RETURN END;
  151.         Texts.OpenReader(R, text, len-1); Texts.Read(R, ch);
  152.         IF ch # 0DX THEN Texts.Write(W, 0DX); Texts.Append(text, W.buf) END;    (*terminate text with a CR*)
  153.         Texts.OpenReader(R, text, 0);
  154.         n := 0; pos := 0; len := text.len;
  155.         IF emptyLines THEN    (*include empty lines*)
  156.             REPEAT
  157.                 j := 0;
  158.                 REPEAT Texts.Read(R, ch); array[n, j] := ch; INC(j) UNTIL ch = 0DX;
  159.                 array[n, j] := 0X; INC(pos, LONG(j));
  160.                 INC(n)    (*
  161.             UNTIL pos = len
  162.         ELSE    (*exclude empty lines*)
  163.             REPEAT
  164.                 j := 0; white := TRUE;
  165.                 REPEAT
  166.                     Texts.Read(R, ch);
  167.                     IF white & ((ch > " ") OR (ch = Texts.ElemChar)) THEN white := FALSE END;
  168.                     array[n, j] := ch; INC(j)
  169.                 UNTIL ch = 0DX;
  170.                 array[n, j] := 0X; INC(pos, LONG(j));
  171.                 IF ~white THEN INC(n) END    (*keep line if not only white-space*)
  172.             UNTIL pos = len
  173.         END
  174.     END FillArray;
  175. Syntax10.Scn.Fnt
  176. FoldElems
  177. Syntax10.Scn.Fnt
  178. Out.Int(ORD(ch), 4);
  179. Syntax10.Scn.Fnt
  180. Out.Int(ORD(ch), 4);
  181.         VAR i, j, delta: INTEGER; ch: CHAR; last: String;
  182.     BEGIN
  183.         IF reverse THEN i := n-1; delta := -1
  184.         ELSE i := 0; delta := 1
  185.         END;
  186.         IF unique THEN
  187.             last[0] := 0X;
  188.             WHILE n > 0 DO
  189.                 IF array[i] # last THEN
  190.                     last := array[i];
  191.                     ch := last[0]; j := 0;
  192.                     WHILE ch # 0X DO Texts.Write(W, ch); (*
  193. *) INC(j); ch := last[j] END;
  194.                     (*Out.Ln;*)
  195.                 END;
  196.                 INC(i, delta); DEC(n)
  197.             END
  198.         ELSE
  199.             WHILE n > 0 DO
  200.                 ch := array[i, 0]; j := 0;
  201.                 WHILE ch # 0X DO Texts.Write(W, ch); (*
  202. *) INC(j); ch := array[i, j] END;
  203.                 (*Out.Ln;*)
  204.                 INC(i, delta); DEC(n)
  205.             END
  206.         END;
  207.         Texts.Append(text, W.buf)
  208.     END FillText;
  209. Syntax10b.Scn.Fnt
  210. Syntax10.Scn.Fnt
  211. FoldElems
  212. Syntax10.Scn.Fnt
  213.         GetNofLines(text, n);
  214.         IF n = 0 THEN WriteMsg(0, ": No output."); RETURN END;
  215.         NEW(array, n);
  216. Syntax10.Scn.Fnt
  217. sorter(array, n);*)
  218.         (*CSortArray(array, n); WriteMsg(n, "sorted.");
  219.         VAR
  220.             V: Viewers.Viewer;
  221.             S: Texts.Scanner;
  222.             x, y, n: INTEGER;
  223.             text, sel: Texts.Text;
  224.             beg, end, time: LONGINT;
  225.             buf: Texts.Buffer;
  226.             array: Array;
  227.             reverse, empty, unique: BOOLEAN;
  228.     BEGIN
  229.         text := TextFrames.Text("");
  230.         Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  231.         IF S.class = Texts.Char THEN
  232.             IF S.c = "*"  THEN    (*text from marked viewer*)
  233.                 V := Oberon.MarkedViewer();
  234.                 IF V.dsc.next IS TextFrames.Frame THEN text := V.dsc.next(TextFrames.Frame).text END
  235.             ELSIF S.c = "^" THEN    (*text from selection*)
  236.                 Oberon.GetSelection(sel, beg, end, time);
  237.                 IF time >= 0 THEN
  238.                     NEW(buf); Texts.OpenBuf(buf); Texts.Save(sel, beg, end, buf);
  239.                     text := TextFrames.Text("");
  240.                     Texts.Append(text, buf)
  241.                 END
  242.             END
  243.         ELSIF S.class = Texts.Name THEN text := TextFrames.Text(S.s)
  244.         END;
  245.         Texts.Scan(S);
  246.         reverse := FALSE; empty := FALSE; unique := FALSE;
  247.         IF (S.class = Texts.Char) & (S.c = "/") THEN
  248.             Texts.Scan(S);
  249.             IF S.class = Texts.Name THEN
  250.                 reverse := (CAP(S.s[0]) = "R") OR (CAP(S.s[1]) = "R") OR (CAP(S.s[2]) = "R");
  251.                 empty := (CAP(S.s[0]) = "E") OR (CAP(S.s[1]) = "E") OR (CAP(S.s[2]) = "E");
  252.                 unique := (CAP(S.s[0]) = "U") OR (CAP(S.s[1]) = "U") OR (CAP(S.s[2]) = "U");
  253.             END
  254.         END;
  255.         NEW(array);
  256.         FillArray(array, n, text, empty); (*WriteMsg(n, "read.");*)
  257.         HSortArray(array, n); (*WriteMsg(n, "sorted.");*)
  258.         text := TextFrames.Text("");
  259.         FillText(text, array, n, reverse, unique); WriteMsg(n, "sorted.");    (*WriteMsg(n, "written.");*)
  260.         Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  261.         V := MenuViewers.New(
  262.             TextFrames.NewMenu("Sorted.Text", "System.Close  System.Copy  System.Grow  Edit.Search  Edit.Store"),
  263.             TextFrames.NewText(text, 0), TextFrames.menuH, x, y);
  264.         array := NIL;
  265.         Oberon.Collect(0)
  266.     END Sort;
  267. ParcElems
  268. Alloc
  269. TableElems
  270. Alloc
  271. Syntax10.Scn.Fnt
  272. ParcElems
  273. Alloc
  274. /table
  275. File    Lines    Comb    Heap
  276. Sort.Mod    247    0.19    0.19
  277. XE.Mod    628    0.62    0.53
  278. O_2.Text    918    0.93    0.77
  279. 2*O_2.Text    1836    2.35    1.71
  280. MODULE Sort;    (**SHML 13-Nov-91, Sorts lines in a text alphabetically**)
  281.     IMPORT
  282.         Oberon, Texts, TextFrames, Viewers, MenuViewers(*, Out, Time*);
  283.     CONST NofLines = 2000;
  284.     TYPE
  285.         String = ARRAY 256 OF CHAR;
  286.         Array = POINTER TO ARRAY NofLines OF String;
  287.     VAR W: Texts.Writer;
  288.     PROCEDURE WriteMsg(n: LONGINT; str: ARRAY OF CHAR);
  289.     (*Write number n followed by str followed by a newline to the Log*)
  290.     PROCEDURE HSortArray(array: Array; n: INTEGER);    (*Sort n elements of array in ascending order, HeapSort*)
  291.     PROCEDURE FillArray(array: Array; VAR n: INTEGER; text: Texts.Text; emptyLines: BOOLEAN);
  292.     (*Fill array with lines from text (including empty lines if requested); return number of lines in n*)
  293.     PROCEDURE FillText(text: Texts.Text; array: Array; n: INTEGER; reverse, unique: BOOLEAN);
  294.     (*Fill text with n lines from array; in reverse order if requested*)
  295.     PROCEDURE Sort*;    (**("^" | "*" | <name>) ["/" {c}]    where c IN {"r", "e", "u"}**)
  296.     (**Sort a marked viewer, a selection, or a file. Option /r means in reverse order; /e keep empty lines**)
  297. BEGIN
  298.     (*sorter := HSortArray*)
  299.     Texts.OpenWriter(W)
  300. END Sort.
  301. Sort.Sort *    Sort marked viewer
  302. Sort.Sort ^    Sort selection
  303. Sort.Sort Test.Text    Sort file 'Test.Text'
  304. Sort.Sort */r    Sort marked viewer in reverse order
  305. Sort.Sort */e    Sort marked viewer including empty lines
  306. Sort.Sort */u    Sort marked viewer keeping unique lines only
  307. Net.SendFiles Pluto shml:Sort.Obj~
  308.